Storm Events Data: Analysis

Author

Emmanuel Guizar Rosales

Published

last rendered on: Aug 16, 2024

Show the code
# install package librarian if needed
if (!("librarian" %in% rownames(installed.packages()))) {
  install.packages("librarian")
}

# load required packages
librarian::shelf(
  tidyverse,
  fs,
  usmap,
  ggpubr
)

# Source required functions
myFunctions <- c(
  "FUNStormEventsData_filterData"
)

for (f in myFunctions) {
  source(paste0("../functions/", f, ".R"))
}

# Preperations to show states boundaries
poly_states <- plot_usmap(regions = "states")

# Read in data_details_fips
fileName <- "data_details_fips.RDS"
pathName <- "../data/stormData"
filePath <- dir_ls(path = pathName, regexp = paste0(fileName, "$")) %>% last()
data_details_fips <- readRDS(filePath)

1 Filter Data

First, we filter the storm events data for the specific years, months, and extreme weather event types we are interested in. We filter for all years from 20214 to 2023 (as data are not complete for the year 2024 yet), we highlight the month of July, and we focus on those types of extreme weather events that are predicted to increase in frequency and severity due to climate change (IPCC 2023): Excessive Heat, Drought, Wildfire, Flash Flood, Coastal Flood, Strong Wind, Hail, and Tornado.

Show the code
# Define variables of interest
myYears <- seq(2014, 2023)
myMonths <- c("July")
myEventTypes <- c(
  "Excessive Heat",
  "Drought",
  "Wildfire",
  "Flash Flood",
  "Coastal Flood",
  "Strong Wind",
  "Hail",
  "Tornado"
)

# Call function
out <- FUNStormEventsData_filterData(
  myData = data_details_fips,
  myYears = myYears,
  myMonths = myMonths,
  myEventTypes = myEventTypes
)

2 Seasonal Distribution

Show the code
p.hist <- out$dataForHist %>% 
  group_by(year) %>% 
  mutate(
    max_nEpisodes = max(nEpisodes),
    yearlyMean_nEpisodes = mean(nEpisodes)
  ) %>% 
  ungroup() %>% 
  mutate(max_month = ifelse(nEpisodes == max_nEpisodes, TRUE, FALSE)) %>% 
  ggplot(aes(
    x = month_name, y = nEpisodes,
    linewidth = max_month,
    fill = month_name %in% myMonths
  )) +
  geom_hline(
    mapping = aes(yintercept = yearlyMean_nEpisodes),
    linetype = "dashed",
    color = "black"
  ) +
  geom_bar(
    stat = "identity",
    color = "black",
    alpha = .7,
    show.legend = FALSE
  ) +
  scale_linewidth_manual(values = c(0.5, 2)) +
  scale_x_discrete(labels = month.abb) +
  scale_fill_manual(
    values = c("darkgrey", "orange"),
  ) +
  labs(
    title = "Number of Extreme Weather Episodes by Month over the Years 2014 to 2023",
    x = "Month",
    y = "Number of Episodes"
  ) +
  theme_bw() +
  theme(
    text = element_text(size = 15),
    plot.title = element_text(hjust = .5),
    axis.text.x = element_text(angle = 90, hjust = 1, vjust = 0.5)
  ) +
  facet_wrap(~year, ncol = 5)


jpeg(
  file = "../images/histogramSeasonalDistribution.jpeg",
  width = 14, height = 7.5, units = "in", res = 600
)
print(p.hist)
invisible(dev.off())

Figure 1 shows something.

3 Geographical Distribution

Show the code
p.map_bin <- plot_usmap(
  data = out$dataForUsPlot,
  values = "episodes_bin",
  regions = "counties",
  exclude = c("AK", "HI"),
  color = "black",
  linewidth = 0.1
  ) +
  geom_sf(
    data = poly_states[[1]] %>% 
      filter(!(abbr %in% c("AK", "HI"))),
    color = "black",
    fill = NA,
    linewidth = .3
  ) +
  scale_fill_manual(
    name = "Number of Episodes > 0",
    values = c("white", "orange")
  ) +
  labs(
    title = "Extreme Weather Episodes in July over the Years 2014 to 2023"
  ) +
  theme_bw() +
  theme(
    text = element_text(size = 15),
    legend.position = "bottom",
    plot.title = element_text(hjust = .5),
    panel.grid = element_blank(),
    axis.ticks = element_blank(),
    axis.text = element_blank()
  ) +
  facet_wrap(~year, ncol = 5)

jpeg(
  file = "../images/mapGeographicalDistribution_bin.jpeg",
  width = 14, height = 7.5, units = "in", res = 600
)
print(p.map_bin)
invisible(dev.off())

Figure 2 shows something else.

Show the code
dataForPlot <- out$dataForUsPlot %>% 
  mutate(nEpisodes_withNA = ifelse(nEpisodes == 0, NA_integer_, nEpisodes))

p.map_cont <- plot_usmap(
  data = dataForPlot,
  values = "nEpisodes_withNA",
  regions = "counties",
  exclude = c("AK", "HI"),
  color = "black",
  linewidth = 0.1
  ) +
  geom_sf(
    data = poly_states[[1]] %>% 
      filter(!(abbr %in% c("AK", "HI"))),
    color = "black",
    fill = NA,
    linewidth = .3
  ) +
  scale_fill_binned(
    name = "Number of Episodes",
    n.breaks = 10,
    type = "viridis",
    na.value = "white"
  ) +
  labs(
    title = "Extreme Weather Episodes in July over the Years 2014 to 2023"
  ) +
  theme_bw() +
  theme(
    text = element_text(size = 15),
    legend.position = "bottom",
    plot.title = element_text(hjust = .5),
    panel.grid = element_blank(),
    axis.ticks = element_blank(),
    axis.text = element_blank()
  ) +
  facet_wrap(~year, ncol = 5)

jpeg(
  file = "../images/mapGeographicalDistribution_cont.jpeg",
  width = 14, height = 7.5, units = "in", res = 600
)
print(p.map_cont)
invisible(dev.off())

p.hist_count <- out$dataForUsPlot %>% 
  group_by(year, nEpisodes) %>% 
  summarise(
    count = n(),
    prcnt = count / n_distinct(out$dataForUsPlot$fips)
  ) %>% 
  ggplot(aes(x = nEpisodes, y = prcnt)) +
  geom_bar(stat = "identity", color = "black", fill = "darkgrey") +
  scale_y_continuous(labels = scales::label_percent()) +
  labs(
    x = "Number of Episodes",
    y = "Proportion of Counties"
  ) +
  theme_bw() +
  labs(
    title = "Extreme Weather Episodes in July over the Years 2014 to 2023"
  ) +
  theme(
    text = element_text(size = 15),
    legend.position = "bottom",
    plot.title = element_text(hjust = .5)
  ) +
  facet_wrap(~year, ncol = 5)

jpeg(
  file = "../images/frequencyDistribution_cont.jpeg",
  width = 14, height = 7.5, units = "in", res = 600
)
print(p.hist_count)
invisible(dev.off())

Figure 4 shows something else.

Figure 3 shows something else.

References

IPCC, ed. 2023. “Weather and Climate Extreme Events in a Changing Climate.” In, 1513–1766. Cambridge: Cambridge University Press. https://doi.org/10.1017/9781009157896.013.